home *** CD-ROM | disk | FTP | other *** search
/ Merciful 4 / Merciful - Disc 4.iso / rexx / saveanimgif.pprx < prev    next >
Text File  |  1996-11-02  |  13KB  |  489 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: SaveAnimGif.pprx 1.0 */
  4.  
  5. /** ENG
  6.  This script saves the current anim-brush as a GIF animation file. Specific
  7.  features of the GIF animation specification can be set through a requester.
  8.  
  9.  This script checks for the differences between frames and only stores
  10.  the smallest rectangular region containing changes. Other techniques
  11.  are employed for additional compression. The resulting GIF animations are
  12.  highly optimized and occupy considerably less space than GIF animations
  13.  created with other tools available on the Amiga.
  14.  
  15.  By default, web browsers play animated GIFs repeatedly and continuously.
  16.  
  17.  The "Use Loop" option inserts an "Application Extension Block" into the GIF
  18.  file (as implemented by Netscape in its Navigator software from version 2).
  19.  This additional block, which is interpreted by most other browsers
  20.  supporting GIF animations, specifies that the animation be repeated as many
  21.  times as indicated by the "Loop" value. A value of 0 expressly means
  22.  "loop continuously".
  23.  
  24.  The list of frames shows the timing value for each frame, in seconds/100.
  25.  These values can be selected, edited and applied to one or more frames.
  26. */
  27.  
  28. /** DEU
  29.  Dieses Skript dient zum Speichern des aktuellen Anim-Brushes als GIF-Animation.
  30.  Eine Reihe spezifischer Merkmale des Animationsformats läßt sich in einem dazugehörigen
  31.  Dialogfenster auswählen.
  32.  
  33.  Nach der Skriptausführung werden zwei aufeinanderfolgende Frames zunächst auf
  34.  Unterschiede untersucht. Gespeichert wird dann nur der kleinste rechteckige
  35.  Bereich, der Unterschiede zwischen den beiden Bildern aufweist. Außerdem
  36.  werden zum Erzielen einer weiter verbesserten Komprimierung noch andere
  37.  Verfahren angewendet. Die daraus resultierenden hochoptimierten GIF-Animationen
  38.  benötigen erheblich weniger Speicherplatz als solche, die mit anderen für den
  39.  Amiga erhältlichen Tools erstellt worden sind.
  40.  
  41.  Animierte GIF-Bilder werden von Web-Browsern standardmäßig in einer
  42.  Endlosschleife abgespielt.
  43.  
  44.  Durch die Option "Schleife aktiv:" wird der GIF-Datei eine Programmerweiterung
  45.  ("Application Extension Block") hinzugefügt, wie sie von Netscape im Navigator
  46.  ab Version 2 implementiert ist. Dieser auch von den meisten anderen Browsern,
  47.  die GIF-Animationen unterstützen, interpretierte Block legt fest, daß die
  48.  Animation so oft wiederholt wird, wie unter "Schleife:" angegeben. Ein Wert
  49.  von 0 bewirkt das Abspielen in einer Endlosschleife.
  50.  
  51.  Die Frameliste zeigt den Timingwert für jedes Einzelbild in Hundertstel
  52.  Sekunden. Diese Werte lassen sich auswählen, bearbeiten und anschließend
  53.  einem oder mehreren Werten zuweisen.
  54.  
  55. */
  56.  
  57. IF ARG(1, EXISTS) THEN
  58.     PARSE ARG PPPORT
  59. ELSE
  60.     PPPORT = 'PPAINT'
  61.  
  62. IF ~SHOW('P', PPPORT) THEN DO
  63.     IF EXISTS('PPaint:PPaint') THEN DO
  64.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  65.         DO 30 WHILE ~SHOW('P',PPPORT)
  66.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  67.         END
  68.     END
  69.     ELSE DO
  70.         SAY "Personal Paint could not be loaded."
  71.         EXIT 10
  72.     END
  73. END
  74.  
  75. IF ~SHOW('P', PPPORT) THEN DO
  76.     SAY 'Personal Paint Rexx port could not be opened'
  77.     EXIT 10
  78. END
  79.  
  80. ADDRESS VALUE PPPORT
  81. OPTIONS RESULTS
  82. OPTIONS FAILAT 10000
  83.  
  84. Get 'LANG'
  85. IF RESULT = 1 THEN DO        /* Deutsch */
  86.     txt_title_req     = 'GIF-Anim-Brush speichern'
  87.     txt_title_set     = 'GIF-Anim-Brush-Einstellungen'
  88.     txt_title_delay   = 'Frame-Verzögerung'
  89.     txt_gad_delay     = 'Frame-Verzögerungen:'
  90.     txt_gad_loop      = '_Schleife:'
  91.     txt_gad_useloop   = 'Schleife ak_tiv:'
  92.     txt_gad_del       = '_Verzögerung (1/100\""):'
  93.     txt_gad_from      = 'A_b Frame:'
  94.     txt_gad_to        = 'Bi_s Frame:'
  95.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  96.     txt_err_notabsh   = 'Aktueller Brush_ist kein Anim-Brush'
  97.     txt_err_notemp    = 'Zu wenig Speicher_für temporären Brush'
  98.     txt_err_nomem     = 'Speichermangel'
  99.     txt_err_nosave    = 'Fehler bei Datei-Ein-/Ausgabe'
  100. END
  101. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  102.     txt_title_req     = 'Scrivere Anim-brush GIF'
  103.     txt_title_set     = 'Parametri Anim-brush GIF'
  104.     txt_title_delay   = 'Temporizzazione'
  105.     txt_gad_delay     = 'Temporizzazione fotogrammi:'
  106.     txt_gad_loop      = 'Cic_lo:'
  107.     txt_gad_useloop   = '_Usare ciclo:'
  108.     txt_gad_del       = '_Temporizzazione (1/100\""):'
  109.     txt_gad_from      = 'Da _fotogramma:'
  110.     txt_gad_to        = 'A f_otogramma:'
  111.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  112.     txt_err_notabsh   = 'Il pennello attuale_non è un anim-brush'
  113.     txt_err_notemp    = 'Impossibile creare_pennello temporaneo'
  114.     txt_err_nomem     = 'Memoria insufficiente'
  115.     txt_err_nosave    = 'Errore di scrittura'
  116. END
  117. ELSE DO                /* English */
  118.     txt_title_req     = 'Save GIF Anim-Brush'
  119.     txt_title_set     = 'GIF Anim-Brush Settings'
  120.     txt_title_delay   = 'Frame Delay'
  121.     txt_gad_delay     = 'Frame Delays:'
  122.     txt_gad_loop      = '_Loop:'
  123.     txt_gad_useloop   = '_Use Loop:'
  124.     txt_gad_del       = '_Delay (1/100\""):'
  125.     txt_gad_from      = '_From Frame:'
  126.     txt_gad_to        = 'T_o Frame:'
  127.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  128.     txt_err_notabsh   = 'The current brush_is not an anim-brush'
  129.     txt_err_notemp    = 'No space for temporary brush'
  130.     txt_err_nomem     = 'Not enough memory'
  131.     txt_err_nosave    = 'File I/O error'
  132. END
  133.  
  134. Version 'REXX'
  135. IF RESULT < 7 THEN DO
  136.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  137.     EXIT 10
  138. END
  139.  
  140. LockGUI
  141. GetBrushAttributes 'FRAMES'
  142. frames = RESULT
  143.  
  144. IF frames < 2 THEN DO
  145.     RequestNotify 'PROMPT "'txt_err_notabsh'"'
  146.     UnlockGUI
  147.     EXIT 0
  148. END
  149.  
  150. GetBrushNumber
  151. bshnum = RESULT
  152.  
  153. SetCurrentBrush 'UNUSED'
  154. IF RC ~= 0 THEN DO
  155.     RequestNotify 'PROMPT "'txt_err_notemp'"'
  156.     UnlockGUI
  157.     EXIT 0
  158. END
  159. GetBrushNumber
  160. tbshnum = RESULT
  161.  
  162. SetCurrentBrush 'BRUSH' bshnum
  163. GetBrushInfo 'ANNOTATION'
  164. annot = RESULT
  165.  
  166. loop = -1
  167. delay. = 0
  168. IF WORD(annot, 1) = 'LOOP' & WORD(annot, 3) = 'DELAY' THEN DO
  169.     loop = WORD(annot, 2)
  170.     IF ~DATATYPE(loop, 'W') THEN
  171.         loop = -1
  172.     DO frm = 1 TO frames
  173.         del = WORD(annot, 3+frm)
  174.         IF DATATYPE(del, 'W') THEN
  175.             delay.frm = del
  176.     END
  177. END
  178. use_loop = (loop >= 0)
  179. IF loop < 0 THEN
  180.     loop = 0
  181.  
  182. fnlen = LENGTH(frames)
  183. dsel = 1
  184. do_req = 1
  185.  
  186. DO WHILE do_req
  187.     req = '"LIST ACTION = ""'txt_gad_delay'"", 'frames', 'dsel-1', 20, 10'
  188.     DO frm = 1 TO frames
  189.         req = req || ', ""'RIGHT(frm, fnlen) || ':' delay.frm || '""'
  190.     END
  191.  
  192.     req = req ||,
  193.         ' INTSTR = ""'txt_gad_loop'"", 0, 32767, 'loop' ' ||,
  194.         'CHECK = ""'txt_gad_useloop'"", 'use_loop' "'
  195.  
  196.     Request 'RESIZE "'txt_title_set'"' req
  197.     IF RC = 0 THEN DO
  198.         dsel = RESULT.1 + 1
  199.         loop = RESULT.2
  200.         use_loop = RESULT.3
  201.         IF RESULT = -1 THEN DO
  202.             Request '"'txt_title_delay'" ' ||,
  203.                         '"INTSTR = ""'txt_gad_del'"", 0, 32767, 'delay.dsel' ' ||,
  204.                         ' SEPARATOR ' ||,
  205.                         ' INTSTR = ""'txt_gad_from'"", 1, 'frames', 'dsel' ' ||,
  206.                         ' INTSTR = ""'txt_gad_to'"", 1, 'frames', 'dsel' "'
  207.             IF RC = 0 THEN DO
  208.                 del    = RESULT.1
  209.                 frfrom = RESULT.2
  210.                 frto   = RESULT.3
  211.                 frstep = SIGN(frto - frfrom)
  212.                 IF frstep = 0 THEN
  213.                     frstep = 1
  214.                 DO frm = frfrom TO frto BY frstep
  215.                     delay.frm = del
  216.                 END
  217.             END
  218.         END
  219.         ELSE do_req = 0
  220.     END
  221.     ELSE DO
  222.         UnlockGUI
  223.         EXIT 0
  224.     END
  225. END
  226.  
  227. IF ~use_loop THEN
  228.     loop = -1
  229. annot = 'LOOP' loop 'DELAY'
  230. DO frm = 1 TO frames
  231.     annot = annot delay.frm
  232. END
  233. SetBrushInfo 'ANNOTATION "'annot'"'
  234.  
  235.  
  236. RequestFile '"'txt_title_req'" SAVEMODE'
  237. IF RC = 0 THEN DO
  238.     PARSE VALUE RESULT WITH '"' fname '"'
  239.     tempfile = 'T:PP_AnGif.'PRAGMA('ID')
  240.  
  241.     GetBrushAttributes 'FRAMEFIRST'
  242.     sv_frmin = RESULT
  243.     GetBrushAttributes 'FRAMELAST'
  244.     sv_frmax = RESULT
  245.     GetBrushAttributes 'LENGTH'
  246.     sv_frlen = RESULT
  247.     GetBrushAttributes 'FRAMEPOSITION'
  248.     sv_frpos = RESULT
  249.     Get 'ICONS'
  250.     sv_icons = RESULT
  251.  
  252.     GetBrushAttributes 'WIDTH'
  253.     bwidth = RESULT
  254.     GetBrushAttributes 'HEIGHT'
  255.     bheight = RESULT
  256.  
  257.     GetBrushAttributes 'TRANSPARENCY'
  258.     transp = RESULT
  259.     GetBrushAttributes 'TRANSPARENTCOLOR'
  260.     transpcol = RESULT
  261.     GetBrushAttributes 'COLORS'
  262.     bcolors = RESULT
  263.     plt_size = bcolors * 3
  264.  
  265.     DO bdepth = 1 TO 8
  266.         IF bcolors = (2 ** bdepth) THEN
  267.             BREAK
  268.     END
  269.  
  270.     tbmap.0 = 0
  271.     tbmap.1 = 0
  272.     tbnum = 0
  273.     gfile_open = 0
  274.     last_plt = ''
  275.     err_msg = ''
  276.  
  277.     SIGNAL ON Break_C
  278.  
  279.     AllocateBitmap bwidth bheight bdepth
  280.     IF RC = 0 THEN DO
  281.         tbmap.0 = RESULT
  282.  
  283.         AllocateBitmap bwidth bheight bdepth
  284.         IF RC = 0 THEN DO
  285.             tbmap.1 = RESULT
  286.  
  287.             SetBrushAttributes 'FRAMEFIRST 1 FRAMELAST' frames 'LENGTH' frames
  288.             Set '"ICONS = 0"'
  289.  
  290.             DO frm = 1 TO frames
  291.                 SetCurrentBrush 'BRUSH' bshnum
  292.                 IF RC ~= 0 THEN DO
  293.                     err_msg = txt_err_nomem
  294.                     BREAK
  295.                 END
  296.  
  297.                 SetBrushAttributes 'FRAMEPOSITION' frm
  298.                 IF RC ~= 0 THEN DO
  299.                     err_msg = txt_err_nomem
  300.                     BREAK
  301.                 END
  302.  
  303.                 GetBitmap '0 0 BITMAP' tbmap.tbnum 'FROMBRUSH'
  304.                 tbnum = 1 - tbnum
  305.  
  306.                 IF frm = 1 THEN DO
  307.                     dx0 = 0
  308.                     dy0 = 0
  309.                     dx1 = bwidth - 1
  310.                     dy1 = bheight - 1
  311.                 END
  312.                 ELSE DO
  313.                     GetBitmapDelta tbmap.0 tbmap.1
  314.                     PARSE VAR RESULT dx0 dy0 dx1 dy1 .
  315.                     IF dx0 < 0 THEN DO
  316.                         dx0 = 0
  317.                         dy0 = 0
  318.                         dx1 = 0
  319.                         dy1 = 0
  320.                     END
  321.                 END
  322.  
  323.                 SetCurrentBrush 'BRUSH' tbshnum
  324.                 IF RC ~= 0 THEN DO
  325.                     err_msg = txt_err_nomem
  326.                     BREAK
  327.                 END
  328.  
  329.                 CopyBrush bshnum dx0 dy0 dx1 dy1 'NOFRAMES'
  330.                 IF RC ~= 0 THEN DO
  331.                     err_msg = txt_err_nomem
  332.                     BREAK
  333.                 END
  334.  
  335.                 SaveBrush tempfile 'FORCE QUIET NOPROGRESS FORMAT "GIF" OPTIONS "GIF89=1" "PROGDSP=0" "SCRFMT=0"'
  336.                 IF RC ~= 0 THEN DO
  337.                     err_msg = txt_err_nosave
  338.                     BREAK
  339.                 END
  340.  
  341.                 IF ~OPEN('tfile', tempfile, 'R') THEN DO
  342.                     err_msg = txt_err_nosave
  343.                     BREAK
  344.                 END
  345.  
  346.                 IF frm = 1 THEN DO
  347.                     IF ~OPEN('gfile', fname, 'W') THEN DO
  348.                         err_msg = txt_err_nosave
  349.                         BREAK
  350.                     END
  351.                     gfile_open = 1
  352.                     data = READCH('tfile', 13)        /* sign + screen descriptor */
  353.                     bxpix = BITOR(BITAND(SUBSTR(data, 11, 1), '07'x), '80'x)
  354.                     CALL WRITECH('gfile', data)
  355.  
  356.                     plt_data = READCH('tfile', plt_size)    /* palette */
  357.                     CALL WRITECH('gfile', plt_data)
  358.                     do_plt = 0
  359.  
  360.                     IF use_loop THEN
  361.                         CALL WRITECH('gfile', '21FF0B'x || 'NETSCAPE2.0' || '0301'x || IntelWord(loop) || '00'x)
  362.                 END
  363.                 ELSE DO
  364.                     SEEK('tfile', 13, 'B')
  365.                     plt_data = READCH('tfile', plt_size)
  366.                     do_plt = (plt_data ~== last_plt)
  367.                 END
  368.                 last_plt = plt_data
  369.  
  370.                 DO FOREVER
  371.                     code = READCH('tfile', 1)
  372.  
  373.                     IF code = ',' THEN DO    /* image */
  374.                         /* gfx control */
  375.                         CALL WRITECH('gfile', '21F904'x || D2C(transp = 1) || IntelWord(delay.frm) || D2C(transpcol) || '00'x)
  376.  
  377.                         data = READCH('tfile', 9)        /* Get image descriptor */
  378.                         imginfo = SUBSTR(data, 9, 1)
  379.                         IF do_plt THEN
  380.                             imginfo = BITOR(BITAND(imginfo, '40'x), bxpix)
  381.  
  382.                         /* image descriptor */
  383.                         CALL WRITECH('gfile', ',' || IntelWord(dx0) || IntelWord(dy0) || IntelWord(dx1-dx0+1) || IntelWord(dy1-dy0+1) || imginfo)
  384.  
  385.                         IF do_plt THEN
  386.                             CALL WRITECH('gfile', plt_data)
  387.  
  388.                         tpos = SEEK('tfile', 0, 'C')
  389.                         epos = SEEK('tfile', 0, 'E')
  390.                         dsize = epos - tpos - 1
  391.                         SEEK('tfile', tpos, 'B')
  392.  
  393.                         /* image data */
  394.                         DO WHILE dsize > 0
  395.                             IF dsize > 65000 THEN
  396.                                 tsize = 65000
  397.                             ELSE
  398.                                 tsize = dsize
  399.                             data = READCH('tfile', tsize)
  400.                             CALL WRITECH('gfile', data)
  401.                             dsize = dsize - tsize
  402.                         END
  403.                         BREAK
  404.                     END
  405.                     ELSE IF code = '!' THEN DO        /* extension */
  406.                         SEEK('tfile', 1, 'C')
  407.                         length = 1
  408.                         DO WHILE length ~= 0
  409.                             length = C2D(READCH('tfile', 1))
  410.                             SEEK('tfile', length, 'C')
  411.                         END
  412.                     END
  413.                     ELSE BREAK
  414.                 END
  415.  
  416.                 CALL CLOSE('tfile')
  417.             END
  418.  
  419.             CALL WRITECH('gfile', ';')
  420.             CALL CLOSE('gfile')
  421.             gfile_open = 0
  422.  
  423.             ADDRESS COMMAND 'Delete >NIL: 'tempfile
  424.  
  425.             SetCurrentBrush 'BRUSH' tbshnum
  426.             IF RC = 0 THEN
  427.                 FreeBrush 'FORCE'
  428.  
  429.             SetCurrentBrush 'BRUSH' bshnum
  430.             IF RC = 0 THEN
  431.                 SetBrushAttributes 'FRAMEFIRST' sv_frmin 'FRAMELAST' sv_frmax 'LENGTH' sv_frlen 'FRAMEPOSITION' sv_frpos
  432.  
  433.             Set '"ICONS =' sv_icons '"'
  434.  
  435.             FreeBitmap tbmap.1
  436.         END
  437.         ELSE err_msg = txt_err_nomem
  438.  
  439.         FreeBitmap tbmap.0
  440.     END
  441.     ELSE err_msg = txt_err_nomem
  442.  
  443.     IF err_msg ~= '' THEN
  444.         RequestNotify 'PROMPT "'err_msg'"'
  445. END
  446. UnlockGUI
  447.  
  448. EXIT 0
  449.  
  450.  
  451.  
  452.  
  453. IntelWord: PROCEDURE
  454.  
  455.     value = ARG(1)
  456.  
  457.     hibyte = value % 256
  458.     lobyte = value - (hibyte * 256)
  459.  
  460.     RETURN D2C(lobyte) || D2C(hibyte)
  461.  
  462.  
  463.  
  464.  
  465. Break_C:
  466.  
  467.     IF gfile_open THEN
  468.         CALL CLOSE('gfile')
  469.  
  470.     ADDRESS COMMAND 'Delete >NIL: 'tempfile
  471.  
  472.     SetCurrentBrush 'BRUSH' tbshnum
  473.     IF RC = 0 THEN
  474.         FreeBrush 'FORCE'
  475.  
  476.     SetCurrentBrush 'BRUSH' bshnum
  477.     IF RC = 0 THEN
  478.         SetBrushAttributes 'FRAMEFIRST' sv_frmin 'FRAMELAST' sv_frmax 'LENGTH' sv_frlen 'FRAMEPOSITION' sv_frpos
  479.  
  480.     Set '"ICONS =' sv_icons '"'
  481.  
  482.     IF tbmap.1 ~= 0 THEN
  483.         FreeBitmap tbmap.1
  484.  
  485.     IF tbmap.0 ~= 0 THEN
  486.         FreeBitmap tbmap.0
  487.  
  488.     RETURN
  489.